home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-01-19 | 18.1 KB | 810 lines | [TEXT/MPS ] |
- (*******************************************************************
-
- Window.p
-
- Demo of a dynamic Window menu.
-
- (c) 1988, by Clifford Story & Attic Software
-
- *******************************************************************)
-
- program Window;
-
- (******************************************************************)
-
- uses memtypes, quickdraw, osintf, toolintf, packintf, Common;
-
- (*******************************************************************
-
- Program constants:
-
- *******************************************************************)
-
- const
-
- applenum = 1001;
- aboutitem = 1;
- atticitem = 2;
-
- filenum = 1002;
- newitem = 1;
- closeitem = 2;
- quititem = 4;
-
- editnum = 1003;
- undoitem = 1;
- cutitem = 3;
- copyitem = 4;
- pasteitem = 5;
- clear = 6;
-
- windnum = 1004;
- zoomitem = 1;
-
- messagedialog = 1001;
-
- windownum = 1001;
- zoomwindnum = 1002;
-
- hoffset = 32;
- voffset = 20;
-
- (*******************************************************************
-
- Program types:
-
- *******************************************************************)
-
- type
-
- datarecord = record
- dummy : WindowRecord;
- recordid : integer;
- next : integer;
- end;
- datapointer = ^datarecord;
-
- (*******************************************************************
-
- Program variables:
-
- *******************************************************************)
-
- var
-
- APPLEMENU : MenuHandle;
- FILEMENU : MenuHandle;
- EDITMENU : MenuHandle;
- WINDOWMENU : MenuHandle;
-
- MENUHEIGHT : integer;
- DRAGRECT : Rect;
- GROWRECT : Rect;
- SCREENRECT : Rect;
-
- WINDOWS : array [0..17] of datarecord;
- FREE : integer;
-
- OLDROM : logical;
- COLUMNS : integer;
- ROWS : integer;
- WINDOWCOUNT : integer;
-
- DONE : logical;
- JEVENT : logical;
- MAINEVENT : EventRecord;
-
- (******************************************************************)
-
- procedure _datainit; external;
-
- (******************************************************************)
-
- {$R-}
- {$SC+}
-
- (******************************************************************)
-
- procedure panic;
-
- begin
-
- ExitToShell;
-
- end;
-
- (******************************************************************)
-
- procedure centerdialog(thetype : OSType; theid : integer);
-
- var
- thehandle : AlertTHndl;
-
- begin
-
- thehandle := AlertTHndl(GetResource(thetype, theid));
- HLock(Handle(thehandle));
- with thehandle^^ do begin
-
- with boundsRect do
- SetRect(boundsRect, 0, 0, right - left, bottom - top);
-
- with screenBits.bounds, boundsRect.botright do
- OffsetRect(boundsRect, (right - left - h) div 2,
- (bottom - top - v + 2 * MENUHEIGHT) div 3);
-
- end;
- HUnlock(Handle(thehandle));
-
- end;
-
- (******************************************************************)
-
- procedure initmac;
-
- begin
-
- MaxApplZone;
- InitGraf(@thePort);
- InitFonts;
- InitWindows;
- InitCursor;
- InitMenus;
- TEInit;
- InitDialogs(@panic);
-
- UnloadSeg(@_datainit);
-
- end;
-
- (******************************************************************)
-
- procedure setupmenus;
-
- begin
-
- APPLEMENU := GetMenu(applenum);
- AddResMenu(APPLEMENU, 'DRVR');
- InsertMenu(APPLEMENU, 0);
-
- FILEMENU := GetMenu(filenum);
- InsertMenu(FILEMENU, 0);
-
- EDITMENU := GetMenu(editnum);
- InsertMenu(EDITMENU, 0);
-
- WINDOWMENU := GetMenu(windnum);
- InsertMenu(WINDOWMENU, 0);
-
- DrawMenuBar;
-
- end;
-
- (*******************************************************************
-
- initglobals
- -----------
-
- Initialize all global variables. This is all standard stuff;
- note, however, that I'm going to keep track of the ROM version,
- since (1) the standard WDEF can't handle zoom windows on the
- 64K ROM, so I want to open standard document windows instead;
- and (2) I don't want to enable the “Zoom Front Window” command
- on the 64K ROM.
-
- *******************************************************************)
-
- procedure initglobals;
-
- var
- index : integer;
-
- begin
-
- for index := 1 to 10 do
- MoreMasters;
-
- OLDROM := BitTst(Ptr(rom85), 0);
-
- if OLDROM then
- MENUHEIGHT := 20
- else
- MENUHEIGHT := shortpointer(mbarheight)^;
-
- if GetResource('PACK', 0) = nil then
- JEVENT := false
- else
- JEVENT := (NGetTrapAddress($A860, ToolTrap)
- <> NGetTrapAddress($A89F, ToolTrap));
-
- with screenBits.bounds do begin
- SetRect(DRAGRECT, left + 5, top + MENUHEIGHT + 5,
- right - 5, bottom - 25);
- SetRect(GROWRECT, 160, 100, right - left - 10,
- bottom - top - MENUHEIGHT - 10);
- SetRect(SCREENRECT, left + 5, top + MENUHEIGHT + 25,
- right - 5, bottom - 5);
- COLUMNS := 1 + ((right - left - 330) div hoffset);
- ROWS := 1 + ((bottom - top - MENUHEIGHT - 230) div voffset);
- end;
-
- for index := 0 to 17 do
- with WINDOWS[index] do begin
- recordid := index;
- next := index + 1;
- end;
- WINDOWS[17].next := -1;
-
- FREE := 0;
- WINDOWCOUNT := 0;
-
- DONE := false;
-
- end;
-
- (*******************************************************************
-
- clickapplemenu
- --------------
-
- This may not be new to you but it is to me! Instead of using an
- alert for the “About...” box, I'm using a picture. First I open
- a new GrafPort, then draw the picture in its center. Note that
- I must re-draw the windows after the user dismisses the screen,
- using PaintBehind.
-
- *******************************************************************)
-
- procedure clickapplemenu(theitem : integer);
-
- var
- itemname : Str255;
- savedport : GrafPtr;
- dummy : integer;
- newport : GrafPort;
- thepicture : PicHandle;
- therect : Rect;
-
- begin
-
- if theitem > 3 then begin
- GetItem(APPLEMENU, theitem, itemname);
- GetPort(savedport);
- dummy := OpenDeskAcc(itemname);
- SetPort(savedport);
- end else if theitem < 3 then begin
-
- InitCursor;
- GetPort(savedport);
- OpenPort(@newport);
- SetPort(@newport);
-
- thepicture := PicHandle(GetResource('PICT',
- 1000 + theitem));
- with thepicture^^.picFrame do
- SetRect(therect, 0, 0, right - left, bottom - top);
- with screenBits.bounds, therect.botright do
- OffsetRect(therect, (right - left - h) div 2,
- (bottom - top - v) div 3);
- DrawPicture(thepicture, therect);
-
- repeat until Button;
-
- ClosePort(@newport);
- EnableItem(EDITMENU, 0);
- DrawMenuBar;
- PaintBehind(WindowPeek(FrontWindow),
- RgnHandle(longpointer(grayrgn)^));
-
- SetPort(savedport);
- FlushEvents(everyEvent, 0);
-
- end;
-
- end;
-
- (******************************************************************)
-
- procedure placewindow(thewindow : WindowPtr);
-
- var
- left : integer;
- top : integer;
-
- begin
-
- left := 5 + hoffset * (WINDOWCOUNT mod COLUMNS);
- top := 5 + MENUHEIGHT
- + voffset * (1 + (WINDOWCOUNT mod ROWS));
-
- MoveWindow(thewindow, left, top, true);
-
- end;
-
- (*******************************************************************
-
- donew
- -----
-
- This routine creates a new window, choosing the window resource
- according to the ROM version. The refcon is set to zero, to
- indicate that the window is unzoomed. The new window will be
- automatically added to the Window menu but the size of the menu
- rectangle must be recalculated.
-
- Since the Window menu can't scroll, it can show only 18 windows
- (20 items, minus the zoom command and the dividing line). So I
- limit the program to those 18. Since the program is limited to
- 18 windows, I allocate a global array of extended WindowRecords
- called WINDOW to avoid fragmenting the heap. Each WindowRecord
- is extended to include two integer fields: the array index of
- the record, and the index of the next record in the free list
- (which is used only if the record is not in use). There's a
- global called FREE that holds the index of the first free record.
-
- When I open a window, I pass the address of the first free record
- for the “wStorage” argument of GetNewWindow. Then I set FREE to
- point to the next free record. The last record points to -1, so
- when all the records are in use, FREE = -1, and I put up an alert.
- (This is a lot easier to code than to explain...)
-
- *******************************************************************)
-
- procedure donew;
-
- label
- 100;
-
- var
- dummy : integer;
- windowtype : integer;
- thewindow : WindowPtr;
- thestring : Str255;
-
- begin
-
- if FREE < 0 then begin
- InitCursor;
- centerdialog('ALRT', messagedialog);
- dummy := Alert(messagedialog, nil);
- goto 100;
- end;
-
- if OLDROM then
- windowtype := windownum
- else
- windowtype := zoomwindnum;
-
- thewindow := GetNewWindow(windowtype,
- @WINDOWS[FREE], WindowPtr(-1));
- placewindow(thewindow);
-
- WINDOWCOUNT := WINDOWCOUNT + 1;
- NumToString(WINDOWCOUNT, thestring);
- SetWTitle(thewindow,
- concat('Window Without a Title #', thestring));
-
- ShowWindow(thewindow);
-
- CalcMenuSize(WINDOWMENU);
-
- FREE := WINDOWS[FREE].next;
-
- 100: end;
-
- (*******************************************************************
-
- doclose
- -------
-
- Here I close a window; if it is an application window, it is
- automatically deleted from the menu but the menu dimensions must
- be recalculated.
-
- Now I must return the WindowRecord to the free list. FREE
- points to the first free record; I just set the newly-freed
- record to point to that record, and set FREE to point to the
- N.F.R. (newly-freed record).
-
- I just put in that array-of-WindowRecord, free-list stuff this
- very morning, and I'm really taken with it. Gonna have to
- re-write all my old stuff...
-
- *******************************************************************)
-
- procedure doclose(thepeek : WindowPeek);
-
- begin
-
- if thepeek^.windowkind < 0 then
- CloseDeskAcc(thepeek^.windowkind)
- else begin
- CloseWindow(WindowPtr(thepeek));
- with datapointer(thepeek)^ do begin
- next := FREE;
- FREE := recordid;
- end;
- CalcMenuSize(WINDOWMENU);
- end;
-
- end;
-
- (******************************************************************)
-
- procedure doquit;
-
- var
- thelong : longpointer;
- thepeek : WindowPeek;
-
- begin
-
- thelong := longpointer(windowlist);
- thepeek := WindowPeek(thelong^);
-
- while thepeek <> nil do begin
- doclose(thepeek);
- thepeek := thepeek^.nextwindow;
- end;
-
- DONE := true;
-
- end;
-
- (******************************************************************)
-
- procedure clickfilemenu(theitem : integer);
-
- begin
-
- case theitem of
- newitem : donew;
- closeitem : doclose(WindowPeek(FrontWindow));
- quititem : doquit;
- end;
-
- end;
-
- (*******************************************************************
-
- zoomthewindow
- -------------
-
- This routine zooms the window. If the refcon is zero, then the
- window is in an unzoomed condition and should be zoomed out.
- Otherwise, the window is at full screen and should be zoomed in.
-
- *******************************************************************)
-
- procedure zoomthewindow(thewindow : WindowPtr);
-
- begin
-
- if GetWRefCon(thewindow) = 0 then begin
- ZoomWindow(thewindow, inZoomOut, true);
- SetWRefCon(thewindow, 1);
- end else begin
- ZoomWindow(thewindow, inZoomIn, true);
- SetWRefCon(thewindow, 0);
- end;
-
- end;
-
- (*******************************************************************
-
- clickwindowmenu
- ---------------
-
- If the “Zoom Front Window” command is selected, then call
- “zoomthewindow” to do the zooming and update the refcon.
- Otherwise, walk the window list to find the window desired and
- select it. This won't be the nth window but rather the nth
- application window.
-
- *******************************************************************)
-
- procedure clickwindowmenu(theitem : integer);
-
- var
- thewindow : WindowPeek;
-
- begin
-
- if theitem = 1 then
- zoomthewindow(FrontWindow)
- else if theitem > 2 then begin
-
- theitem := theitem - 2;
-
- thewindow := WindowPeek(longpointer(windowlist)^);
- while (not thewindow^.visible)
- or (thewindow^.windowkind <> userKind) do
- thewindow := thewindow^.nextwindow;
-
- while theitem > 1 do begin
- theitem := theitem - 1;
- repeat
- thewindow := thewindow^.nextwindow;
- until thewindow^.visible
- and (thewindow^.windowkind = userKind);
- end;
-
- SelectWindow(WindowPtr(thewindow));
-
- end;
-
- end;
-
- (*******************************************************************
-
- checkmenu
- ---------
-
- This routine is called just before MenuSelect or MenuKey, to
- make sure the menu items are appropriately enabled or disabled.
- Note that the “Zoom Front Window” item on the Window menu is
- never enabled on the 64K ROM.
-
- *******************************************************************)
-
- procedure checkmenu(thewindow : WindowPeek);
-
- begin
-
- DisableItem(EDITMENU, 0);
- DisableItem(WINDOWMENU, zoomitem);
-
- if thewindow = nil then
- DisableItem(FILEMENU, closeitem)
- else begin
- if thewindow^.windowkind <> userKind then
- EnableItem(EDITMENU, 0)
- else if not OLDROM then
- EnableItem(WINDOWMENU, zoomitem);
- EnableItem(FILEMENU, closeitem);
- end;
-
- end;
-
- (******************************************************************)
-
- procedure clickinmenu;
-
- var
- choice : long;
-
- begin
-
- checkmenu(WindowPeek(FrontWindow));
- choice := MenuSelect(MAINEVENT.where);
-
- case HiWord(choice) of
- applenum : clickapplemenu(LoWord(choice));
- filenum : clickfilemenu(LoWord(choice));
- editnum : if SystemEdit(LoWord(choice) - 1) then;
- windnum : clickwindowmenu(LoWord(choice));
- end;
-
- HiliteMenu(0);
-
- end;
-
- (*******************************************************************
-
- clickindrag
- -----------
-
- A drag will take the window out of full-zoom position if it was
- in it, so clear the refcon.
-
- *******************************************************************)
-
- procedure clickindrag(thewindow : WindowPtr);
-
- begin
-
- DragWindow(thewindow, MAINEVENT.where, DRAGRECT);
- SetWRefCon(thewindow, 0);
-
- end;
-
- (*******************************************************************
-
- clickingrow
- -----------
-
- Growing the window will take it out of full-zoom position if it
- was in it, so clear the refcon afterwards.
-
- *******************************************************************)
-
- procedure clickingrow(thewindow : WindowPtr);
-
- var
- newsize : long;
-
- begin
-
- newsize := GrowWindow(thewindow, MAINEVENT.where, GROWRECT);
- if newsize <> 0 then begin
- InvalRect(thewindow^.portRect);
- SizeWindow(thewindow, LoWord(newsize), HiWord(newsize), true);
- SetWRefCon(thewindow, 0);
- end;
-
- end;
-
- (******************************************************************)
-
- procedure clickingoaway(thewindow : WindowPtr);
-
- begin
-
- if TrackGoAway(thewindow, MAINEVENT.where) then
- doclose(WindowPeek(thewindow));
-
- end;
-
- (*******************************************************************
-
- clickinzoom
- -----------
-
- Instead of calling ZoomWindow directly, I'm going to call an
- intermediate routine (discussed above) to keep track of whether
- the window is zoomed in or out.
-
- *******************************************************************)
-
- procedure clickinzoom(thewindow : WindowPtr; thezoom : integer);
-
- begin
-
- if TrackBox(thewindow, MAINEVENT.where, thezoom) then
- zoomthewindow(thewindow);
-
- end;
-
- (******************************************************************)
-
- procedure aclick;
-
- var
- location : integer;
- thewindow : WindowPtr;
-
- begin
-
- location := FindWindow(MAINEVENT.where, thewindow);
-
- case location of
- inDesk : SysBeep(1);
- inMenuBar : clickinmenu;
- inSysWindow : SystemClick(MAINEVENT, thewindow);
- inContent : SelectWindow(thewindow);
- inDrag : clickindrag(thewindow);
- inGrow : clickingrow(thewindow);
- inGoAway : clickingoaway(thewindow);
- inZoomIn : clickinzoom(thewindow, inZoomIn);
- inZoomOut : clickinzoom(thewindow, inZoomOut);
- end;
-
- end;
-
- (******************************************************************)
-
- procedure akey;
-
- var
- charcode : integer;
- choice : long;
-
- begin
-
- if BitAnd(MAINEVENT.modifiers, cmdKey) <> 0 then begin
-
- charcode := BitAnd(MAINEVENT.message, charCodeMask);
- checkmenu(WindowPeek(FrontWindow));
- choice := MenuKey(chr(charcode));
-
- if choice <> 0 then begin
-
- case HiWord(choice) of
- applenum : clickapplemenu(LoWord(choice));
- filenum : clickfilemenu(LoWord(choice));
- editnum : if SystemEdit(LoWord(choice) - 1) then;
- windnum : clickwindowmenu(LoWord(choice));
- end;
-
- HiliteMenu(0);
-
- end;
-
- end;
-
- end;
-
- (******************************************************************)
-
- procedure anactivate(thewindow : WindowPtr);
-
- var
- savedport : GrafPtr;
-
- begin
-
- SetPort(thewindow);
- DrawGrowIcon(thewindow);
-
- end;
-
- (******************************************************************)
-
- procedure anupdate(thewindow : WindowPtr);
-
- var
- savedport : GrafPtr;
-
- begin
-
- GetPort(savedport);
- SetPort(thewindow);
-
- BeginUpdate(thewindow);
-
- ClipRect(thewindow^.portRect);
- EraseRect(thewindow^.portRect);
- DrawGrowIcon(thewindow);
-
- EndUpdate(thewindow);
-
- SetPort(savedport);
-
- end;
-
- (******************************************************************)
-
- procedure mainloop;
-
- var
- dummy : logical;
-
- begin
-
- repeat
-
- if JEVENT then
- dummy := waitnextevent(everyEvent, MAINEVENT,
- GetCaretTime, nil)
- else begin
- SystemTask;
- dummy := GetNextEvent(everyEvent, MAINEVENT);
- end;
-
- if dummy then begin
- case MAINEVENT.what of
- mouseDown : aclick;
- keyDown : akey;
- activateEvt : anactivate(WindowPtr(MAINEVENT.message));
- updateEvt : anupdate(WindowPtr(MAINEVENT.message));
- end;
- end;
-
- until DONE;
-
- end;
-
- (******************************************************************)
-
- begin
-
- initmac;
- setupmenus;
- initglobals;
-
- mainloop;
-
- end.
-
- (******************************************************************)
-